Como encontrar as cartas de Gwent mais similares entre si?

Já olhamos os decks de Gwent para identificar e explorar as regras de associação entre as cartas, o que alavanca as estratégias de utilização das mesmas conhecidas pela comunidade. Neste post vamos tomar outra abordagem e buscar os pares de cartas cujas características são mais similares entre si e que, portanto, poderia fornecer algum outro tipo de estratégia ainda não explorada e/ou facilitar a nossa vida quanto à escolha das cartas que colocaremos em um deck

Motivação

Há algum tempo atrás construí um scrapper para raspar a biblioteca de decks de Gwent, de forma à usar esses dados para me ajudar à tomar melhores decisões na hora de montar meus próprios decks. Uma das primeiras análises que fiz com aqueles dados foi tentar entender os padrões de co-ocorrência das cartas de Gwent entre os decks contribuídos pela comunidade, utilizando para isso uma análise orientada à regras de associação. Este primeiro exercício acabou sendo bastante positivo, pois consegui extrair alguns insights bastante relevantes, que acabaram melhorando a minha estratégia e experiência de jogo.

Um ponto importante daquela primeira análise é que ela olhou para os padrões de co-ocorrência de cartas conhecidos e explorados pela comunidade, deixando de fora àquelas combinações de cartas que teriam o potencial de funcionar juntas, mas que nunca foram testadas. Estas combinações normalmente implementam mecânicas específicas de jogo, que podem ser identificadas através da descrição dos efeitos associados à cada carta. Assim, se pudéssemos agrupar as cartas de acordo com os padrões de texto existente em suas descrições, então poderíamos identificar as cartas que implementam mecânicas similares e, portanto, poderiam ser usadas juntas.

Uma forma de implementar este tipo de agrupamento é através da modelagem de tópicos, uma técnica de aprendizado não-supervisionado que faz uso de modelos estatísticos para encontrar temas abstratos de acordo com as palavras compõem os textos em uma coleção dos mesmos. Existem alguns modelos que podem ser implementados para esta finalidade, sendo o mais conhecido deles a LDA - Latent Dirichlet Allocation; todavia, vou utilizar este post para estudar, explorar e demonstrar as funcionalidades de um outro modelo de tópicos: o STM, Structural Topic Model (Roberts, Stewart, and Tingley (2019)). Meu objetivo com isso será utilizar este modelo para criar uma representação do quão similares as cartas são de acordo com seus padrões de texto e utilizar esta representação para encontrar as cartas mais similares àquela que eu resolver buscar.

Antes de chegar aos objetivos finais desta análise vamos cobrir alguns pontos importantes. Iniciaremos falando um pouco sobre a aquisição dos dados e, então, passaremos para uma breve análise exploratória. Começaremos a modelagem de tópicos falando um pouquinho mais da intuição por trás do STM e, então, vamos implementar tanto uma busca pela quantidade de tópicos que devemos utilizar antes de ajustar o modelo em si. A partir daí conduziremos algumas análises relacionadas ao pós-processamento e entedimento dos tópicos, bem como a validação do modelo. Fecharemos então o post mostrando a aplicação do modelo para atingir os objetivos principais que definimos.

Carregando os Dados

Os dados que vamos utilizar neste post podem ser obtidos utilizando o scrapper apresentado neste post. O resultado daquele processamento retorna um tibble com a composição de cartas em cada um dos decks rasparados, bem como os metadados associados à cada uma das cartas. Assim, podemos reduzir àquela base à uma que fale apenas das cartas se usarmos um distict focando apenas no nome das cartas e em seus metadados. Você pode encontrar esta etapa do pós-processamento no código que acompanha este post.

Assumindo que já temos a base de dados com os metadados de cada carta, vamos carregar alguns pacotes que usaremos neste post e, na sequência, carregar a base de dados. Precisaremos fazer dois pequenos ajustes, para resolver duas inconsistências que existem neles:

• A carta Solução engenhosa possui dois nomes em inglês - Blueprint e Engineering solution -, o que faz com que esta carta esteja duplicada na nossa base de dados. Assim, precisaremos remover uma ocorrência dela (selecionei remover a Blueprint, mas não faz diferença); e,
  
• Existem duas cartas diferentes com o mesmo nome: Vidente, mas uma pentercente à facção Scoia'tael e a outra é uma carta Neutra. Assim, para evitar confusões, vamos adicionar o nome da facção ao nome da carta.

# carregando os pacotes
library(tidyverse) # core
library(tidytext) # para manipular texto
library(patchwork) # para compor figuras
library(stringi) # para trabalhar com texto
library(reactable) # para tabelas interativas
library(reactablefmtr) # para ajudar com o reactable

# carregando os dados
cartas <- read_rds(file = 'data/cartas.rds')
# cartas <- read_rds(file = '_posts/2022-01-31-card-embeddings-parte-1/data/cartas.rds')

# ajustando a tabela por conta de duas cartas má registradas
cartas <- cartas %>% 
  # removendo a carta Solução Engenhosa, que aparece duas vezes por conta de diferencas
  # em seu nome em ingles
  filter(!(localizedName == 'Solução engenhosa' & name != 'Blueprint')) %>% 
  # ajustando o nome da carta Vidente, que aparece duas vezes pois existe uma na facção
  # neutra e outra na Scoia'tael, mas sao cartas diferentes
  mutate(
    localizedName = case_when(localizedName == 'Vidente' ~ paste0(localizedName, ' (', slug, ')'),
                              TRUE ~ localizedName)
  ) %>% 
  # colocando as cartas em ordem alfabetica
  arrange(localizedName)
cartas

# A tibble: 1,103 × 19
   localizedName name  short slug  rarity cardGroup type  categoryName
   <chr>         <chr> <chr> <chr> <chr>  <chr>     <chr> <chr>       
 1 A Fera        The … mon   Mons… Épica  gold      Unid… Espectro    
 2 A prática le… Prac… nor   Nort… Rara   bronze    Espe… Feitiço     
 3 A Terra das … Land… neu   Neut… Lendá… gold      Arte… Local       
 4 A Trufa Carn… The … neu   Neut… Lendá… gold      Arte… Local       
 5 Abaya         Abaya mon   Mons… Épica  gold      Unid… Necrófago   
 6 Aberrações d… Whor… syn   Synd… Épica  gold      Unid… Humano, Bil…
 7 Abominação S… Sala… syn   Synd… Rara   bronze    Unid… Fera, Mutan…
 8 Acônito       Wolf… neu   Neut… Lendá… gold      Espe… Nenhuma     
 9 Açougueiro d… Sval… ske   Skel… Comum  bronze    Unid… Humano, Cul…
10 Adaga Cerimo… Cere… neu   Neut… Lendá… gold      Estr… Estratégia  
# … with 1,093 more rows, and 11 more variables: ownable <lgl>,
#   decks <int>, craftingCost <int>, power <int>,
#   provisionsCost <int>, armour <int>, keywords <chr>, texto <chr>,
#   fluff <chr>, small <chr>, big <chr>

Se tudo estiver correto, devemos ter 1.103 cartas em nossa base de dados. Além disso, devemos ter muito mais cartas Neutras do que cartas de facção dentro da nossa base, um pouquinho mais de cartas da facção Syndicate do que das demais facções, e um número similar de cartas entre todas as outras cinco facções - conforme apresentado na figura abaixo. Estes padrões de variação na quantidade de cartas parecem estar associados à natureza daquelas duas primeiras: cartas neutras podem ser utilizadas com os decks de qualquer facção, assim como algumas cartas específicas da facção Syndicate.

Show code

cartas %>% 
  # contando quantidade de cartas existentes por faccao
  count(slug, name = 'n_cartas') %>% 
  # ordenando as colunas
  mutate(slug = fct_reorder(.f = slug, .x = n_cartas)) %>%
  # criando a figura
  ggplot(mapping = aes(x = n_cartas, y = slug, fill = slug)) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  geom_text(mapping = aes(label = n_cartas), nudge_x = 10, fontface = 'bold') +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title = 'Quantas cartas diferentes existem por facção?',
    x     = 'Quantidade de cartas'
  ) +
  theme(axis.title.y = element_blank())

Com tudo carregado, podemos começar a análise exploratória dos dados das cartas. Nosso principal foco será entender de onde vem as principais diferenças entre as cartas dentro e entre as facções, e como isto está relacionado às estratégias e mecânicas de jogo.

Análise Exploratória de Dados

Vamos começar olhando as nossas análises focando nos textos de descrição associados à cada carta. Para isso, vamos quebrar os textos em tokens utilizando a função unnest_tokens, remover os nomes de algumas das facções que estejam entre os resultados (bem como as cartas que simplesmente não tem nenhum texto associado) e, finalmente, contar quantas vezes cada palavra ocorre em cada carta. Uma vez que tenhamos essa estrutura de dados, vamos usar a função bind_tf_idf para calcular o tf-idf (term frequency-inverse document frequency) associado à cada palavra entre as cartas dentro de cada facção. Esta métrica representa o equilíbrio entre a frequência de ocorrência de uma palavra entre todas as cartas de uma dada facção e a frequência com a qual àquela mesma palavra ocorre entre todas as cartas: quanto mais exclusiva à uma facção for uma palavra, maior será o valor desta métrica. Desta forma, esta métrica nos ajuda à identificar mais facilmente as palavras mais representativas das cartas de cada facção.

Os resultados desta análise preliminar são apresentados na figura abaixo, que confirma a expectativa de que existem diferenças nas palavras associadas aos textos de descrição de cada carta. Ao que podemos observar, estes textos são muito informativos de alguns temas que parecem ser inerentes à cada facção e outros temas que parecem ser comuns entre elas.

Show code

cartas %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto, to_lower = TRUE) %>% 
  # removendo os NAs e algumas palavras que não ajudam a visualização
  filter(!is.na(token), 
         str_detect(string = token, pattern = "scoia'tael|reinos|skellige|norte|dos", negate = TRUE)) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 15 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 15, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_x_continuous(labels = scales::label_number(accuracy = 0.001)) +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais as palavras mais representativas das cartas de cada facção?',
    subtitle = 'As palavras associadas à cada facção remetem às mecânicas, estratégias e personagens associados à cada uma delas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Um dos temas comuns que pudemos observar na figura acima é a citação à diversos tipos de personagens comuns em gêneros de RPG. O exemplo mais claro disso é aquele observado na facção Scoia'tael, onde vimos que palavras como elfo, anão e dríade são bastante característicos. Para validar essa observação, calculei o tf-idf focando na informação dos tipos de personagem associados à cada carta, de forma à identificar mais claramente os personagens característicos de cada facção. Em linha com o que esperávamos, os personagens associados à cada facção retratam a natureza de cada uma delas: observamos diversos monstros e nenhum bruxo na facção Monsters, muitas criaturas da floresta, elfos e anões na facção Scoia'tael e diversos personagens associados à guerras e batalhas nas facções Nilfgaard e Northern Realms. Conhecer essas associações são importantes pois algumas mecânicas de jogo dependem do tipo de personagem associado à cada carta (e.g., ‘invoca uma carta da Caçada Selvagem’) e, ainda, existem modos de jogo que favorecem alguns tipos de personagens específicos (e.g., bruxos não são penalizados).

Show code

cartas %>% 
  # pegando apenas as cartas de unidade
  filter(type == 'Unidade') %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = categoryName, to_lower = FALSE, 
                token = 'regex', pattern = ', ') %>% 
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 15 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_x_continuous(breaks = seq(from = 0, to = 0.3, by = 0.05)) +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais os tipos de personagem associados às cartas de cada facção?',
    subtitle = 'Os personagens associados à cada facção retratam a natureza de cada uma delas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Além do texto de descrição das cartas tocar no tema dos tipos de personagem, ela também toca nos tipos de habilidade que cada carta implementa. Na realidade, existem 75 habilidades diferentes que podem estar associadas às cartas, sendo que cada carta pode ter um número qualquer de habilidades - de nenhuma à várias. As habilidades associadas à cada carta são apresentadas na coluna keywords, e são separadas umas das outras através de um ponto-e-vírgula. Para construir o mesmo tipo de intuição sobre as habilidades mais representativas das cartas de cada facção, utilizei novamente o tf-idf. O resultado dessa análise é apresentada através da figura abaixo, onde podemos ver que:

• Algumas habilidades parecem ser exckusivas à uma determinada facção. Alguns exemplos disso são: consumir (consume) da facção Monsters, lucrar (profit) e moedas (coin) da facção Syndycate e assimilar (assimilate) da facção Nilfgaard;
  
• Existem habilidades que parecem estar associadas à mais de uma facção, como desejo de morte (deathwish; Monsters, Northern Realms e Skellige) e envenenamento (poison; Neutral, Nilfgaard, Scoia'tael e Syndicate); e,
  
• Mesmo as cartas Neutras parecem ter habilidades que são mais frequentes ali do que nas outras facções, como iniciativa (initiative) e cataclisma (cataclysm).

Show code

cartas %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = keywords, to_lower = FALSE, 
                token = 'regex', pattern = ';') %>% 
  # removendo os NAs
  filter(!is.na(token)) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 10 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Quais as habilidades mais representativas das cartas de cada facção?',
    subtitle = 'Algumas habilidades parecem ser específicas de certas facções, outras são compartilhadas entre poucas',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Se a informação dos tipos de habilidades que uma carta têm está relacionada à descrição da carta, então não bastaria utilizarmos àquela primeira informação para achar as cartas mais similares entre si? Embora essa lógica não esteja errada, ela perde de vista um segundo aspecto importante que podemos encontrar nos textos de descrição de cada carta: a forma como as suas habilidades são implementadas. Vamos tomar como exemplo a habilidade sangramento (i.e., bleeding), que está presente entre as cartas de todas as facções: a carta que possui esta habilidade pode adicionar um status à uma carta inimiga, fazendo com que ela perca um ponto de poder por turno de jogo até um limite n de turnos (que depende da carta). Apesar da ideia por trás desta habilidade ser simples, podemos ver através da figura abaixo que as cartas à implementam de forma bem diferente entre e dentro das facções: e.g. pagando algum tipo de custo, assim que são postas no tabuleiro, quando estão com seu poder aumentado ou quando tem o seu poder aumentado e etc. Assim, é interessante então que agrupemos as cartas não só pelas habilidades que elas compartilham, mas também pela forma como as implementam.

Show code

cartas %>% 
  # filtrando cartas com uma habilidade especifica
  filter(str_detect(string = keywords, pattern = 'bleeding')) %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto, to_lower = TRUE) %>% 
  # removendo os NAs e numeros
  filter(
    !is.na(token),
    str_detect(string = token, pattern = '[0-9]', negate = TRUE),
    !token %in% c('a', 'à', 'ao', 'com', 'de', 'e', 'na', 'no', 'o', 'um')
  ) %>%
  # contando as categorias por faccao
  count(slug, token, name = 'ocorrencias') %>% 
  # calculando o tf-idf
  bind_tf_idf(term = token, document = slug, n = ocorrencias) %>% 
  # agrupando pela faccao
  group_by(slug) %>% 
  # pegando os 10 tokens com maior tf-idf
  slice_max(order_by = tf_idf, n = 10, with_ties = FALSE) %>% 
  # desagrupando
  ungroup %>% 
  # ordenando as colunas
  mutate(token = reorder_within(x = token, by = tf_idf, within = slug)) %>% 
  # criando a figura
  ggplot(mapping = aes(x = tf_idf, y = token, fill = slug)) +
  facet_wrap(~ slug, scales = 'free') +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title    = 'Como a habilidade sangramento é implementada entre facções?',
    subtitle = 'Uma mesma habilidade pode ser implementada de diferentes formas entre e dentro das facções',
    x        = 'TF-IDF'
  ) +
  theme(axis.title.y = element_blank())

Acredito que já conseguimos ter um bom entendimento da relação do texto de descrição das cartas com os tipos de mecânica de jogo e as suas implementações. Vamos agora passar para a modelagem de tópicos, onde buscaremos segmentar as cartas de acordo com estes padrões.

Modelagem

Vamos começar dando um pouco mais de contexto sobre a modelagem de tópicos e de que forma o STM se encaixa dentro deste arcabouço. A partir daí vamos avançar para a preparação dos dados para o modelo, a busca pela quantidade de tópicos que devemos utilizar e, finalmente, ajustaremos o modelo selecionado.

Intuição geral sobre o STM

Explica LDA.

Show code

knitr::include_graphics(path = 'images/lda_rationale.png')

Explica STM.

Show code

knitr::include_graphics(path = 'images/stm_rationale.png')

Preparação dos dados

Lista de stopwords personalizada.

my_stopwords <- c('a', 'ao', 'aos', 'ate', 'cada', 'com', 'as', 'como', 'da', 'das', 
                  'de', 'dela', 'delas', 'dele', 'desta',  'deste', 'destas', 'destes',
                  'deles', 'do', 'dos', 'disso', 'e', 'es', 'em', 'esta',  'ela', 'ele',
                  'elas', 'eles', 'for', 'foi', 'la', 'lhe', 'mais', 'nas', 'nesta', 
                  'na', 'nas', 'nela', 'nele', 'no', 'nos', 'o', 'os', 'ou', 'para',
                  'por', 'pelo', 'que', 'sao', 'se', 'so', 'sos', 'sem', 'seu', 'seus',
                  'sua', 'suas', 's', 'si', 'todas', 'todos', 'tem', 'um', 'uma', 'voce',
                  'vez', 'longa', 'distancia', 'corpo', 'duas', 'dois', 'metade', 'reinos',
                  'norte', "scoia'tael", 'skellige', 'nilfgaard', 'sindicato', 'neutra',
                  'concede', 'tiver', 'seguida', 'seja', 'caso', 'faz', 'usa', 'usar',
                  'usando', 'usada', 'usado', 'tambem', 'houver', 'ha', 'pela', 'mesma',
                  'tiver', 'nao', 'nessa', 'nessas', 'nesse', 'nesses', 'qualquer', 
                  'estiver', 'entre', 'unidade', 'unidades', 'mobilizacao', 'sempre', 
                  'mesmo', 'perto', 'apos', 'quando', 'neste', 'nestes', "scoia'tel",
                  'enquanto')

Preparando os dados.

txt <- 'Esta habilidade adiciona [0-9]{2} (?:(?:de )?recrutamento[s]? ao limite )?de recrutamento (ao limite )?do (?:seu )?baralho.'

# contando ocorrencias de cada token por faccao
df_tokens <- cartas %>% 
  # removendo texto comum a todas as cartas de habilidade do lider
  mutate(
    texto = str_remove(string = texto, pattern = txt)
  ) %>% 
  # quebrando o string em tokens
  unnest_tokens(output = token, input = texto) %>% 
  # removendo acentuacao
  mutate(token = stri_trans_general(str = token, id = 'Latin-ASCII')) %>%
  # removendo stopwords
  filter(!token %in% my_stopwords) %>% 
  # removendo os digitos
  filter(str_detect(string = token, pattern = '[0-9]', negate = TRUE)) %>% 
  # substituindo algumas formas
  mutate(
    token = str_replace(string = token, pattern = '(?<=o|a)s$', replacement = ''),
    token = str_replace(string = token, pattern = '(?<=d|t)es$', replacement = 'e'),
    token = str_replace(string = token, pattern = '(?<=r)es$', replacement = ''),
    token = str_replace(string = token, pattern = 'veneno|envenenamento|envenenad[ao]', replacement = 'envenena'),
    token = str_replace(string = token, pattern = 'bloqueada|bloquei[ao]', replacement = 'bloqueio'),
    token = str_replace(string = token, pattern = 'reforcad[ao]', replacement = 'reforcada'),
    token = str_replace(string = token, pattern = 'anoes', replacement = 'anao'),
    token = str_replace(string = token, pattern = 'aleatoriamente', replacement = 'aleatorio'),
    token = str_replace(string = token, pattern = 'aleatoria', replacement = 'aleatorio'),
    ) %>% 
  # contando ocorrencia dos lemmas por carta
  count(localizedName, token, name = 'ocorrencias') 
df_tokens

# A tibble: 7,425 × 3
   localizedName              token     ocorrencias
   <chr>                      <chr>           <int>
 1 A Fera                     batalha             1
 2 A Fera                     campo               1
 3 A Fera                     fim                 1
 4 A Fera                     maior               1
 5 A Fera                     poder               1
 6 A Fera                     reforca             1
 7 A Fera                     turno               1
 8 A prática leva à perfeição aleatorio           1
 9 A prática leva à perfeição aliado              1
10 A prática leva à perfeição aumenta             1
# … with 7,415 more rows

Lematizando os tokens e contando-os.

Show code

# carregando mais pacotes
library(spacyr) # para ajudar com lematizacao

# inicializando o spacy
spacy_initialize(model = 'pt_core_news_lg')

# criando uma base de-para para lemmatizar os tokens
de_para_lemma <- distinct(df_tokens, token) %>% 
  # colocando os tokens em um vetor
  pull(token) %>% 
  # parseando os tokens para o spacyr
  spacy_parse(pos = FALSE, tag = FALSE, lemma = TRUE, dependency = FALSE) %>% 
  # passando o resultado para um tibble
  tibble %>% 
  # pegando apenas as colunas que interessam
  select(token, lemma)
  
# lemmatizando os tokens e contando ocorrencias
df_tokens <- df_tokens %>% 
  # juntando o de-para de lemmas aos tokens
  left_join(y = de_para_lemma, by = 'token') %>% 
  # contando ocorrencia dos lemmas por carta
  count(localizedName, lemma, name = 'ocorrencias')
df_tokens

Criando matriz DFM.

# criando matriz no formato document-feature matrix
df_esparsa <- df_tokens %>% 
  cast_sparse(row = localizedName, column = token, value = ocorrencias)

Determinando a quantidade de tópicos

Procurando o valor de K.

# carregando mais pacotes
library(stm) # para a modelagem de topicos
library(furrr) # para paralelizar a busca

# setando a seed
set.seed(33)

# setando o processamento paralelo
plan(multisession)

# buscando melhor valor de K
search_K <- tibble(
  K = seq(from = 6, to = 30, by = 3)
) %>% 
  mutate(
    # rodando o STM sem nenhuma feature
    padrao = future_map(.x = K, 
                        .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                   seed = 333, K = .x, verbose = FALSE),
                        .options = furrr_options(seed = TRUE)
    ),
    # passando a faccao para o content
    features = future_map(.x = K, 
                          .f = ~ stm(documents = df_esparsa, init.type = 'Spectral', 
                                     seed = 333, K = .x, content = ~ slug, data = cartas,
                                     verbose = FALSE),
                          .options = furrr_options(seed = TRUE)
    )
  ) %>% 
  pivot_longer(cols = c(padrao, features), names_to = 'tipo', values_to = 'modelos')

# setando o processamento sequencial
plan(sequential)

Extraindo métricas de avaliação.

Show code

# extraindo as metricas de avaliacao da clusterizacao
metricas <- search_K %>% 
  # calculando a exclusividade e a coerencia dos topicos
  mutate(
    exclusividade = map(.x = modelos, .f = safely(exclusivity)),
    exclusividade = map(.x = exclusividade, .f = 'result'),
    coerencia     = map(.x = modelos, .f = semanticCoherence, documents = df_esparsa),
    residuos      = map(.x = modelos, .f = checkResiduals, df_esparsa),
    residuos      = map(.x = residuos, 'dispersion')
  ) %>% 
  # dropando a coluna com os modelos
  select(-modelos) %>% 
  # desaninhando as colunas de coerencia e exclusividade
  unnest(cols = c(exclusividade, coerencia, residuos))

# plotando as metricas individualmente
fig_painel_metricas <- metricas %>%
  # passando a base para o formato longo
  pivot_longer(cols = c(exclusividade, coerencia, residuos), 
               names_to = 'metrica', values_to = 'valor') %>% 
  # dropando valores nulos
  drop_na() %>% 
  # agrupando pelo valor de K e da metrica
  group_by(K, metrica, tipo) %>% 
  # calculando o valor da media da metrica por valor de K
  summarise(
    valor = mean(x = valor, na.rm = TRUE), .groups = 'drop'
  ) %>% 
  # renomeando as metricas
  mutate(
    metrica = case_when(metrica == 'coerencia' ~ 'Coerência Semântica',
                        TRUE ~ str_to_title(string = metrica))
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = as.factor(K), y = valor, group = tipo, color = tipo)) +
  facet_wrap(~ metrica, scales = 'free') +
  geom_line(size = 1, show.legend = FALSE) +
  geom_point(fill = 'white', color = 'black', shape = 21, size = 3, show.legend = FALSE) +
  labs(
    caption = 'A linha azul representa o modelo que não contempla que a ocorrência das palavras pode variar dentro dos tópicos em função da identidade da facção.',
    x       = 'Quantidade de tópicos (K)',
    y       = 'Valor da métrica'
  )

# plotando as metricas de coerencia vs exclusividade
fig_coerencia_exclusividade <- metricas %>% 
  # filtrando os resultado do modelo sem content
  filter(tipo == 'padrao') %>% 
  # adicionando a sequencia do numero de topicos
  mutate(
    K = ifelse(test = K < 10, yes = paste0('0', K), no = K),
    K = paste(K, 'tópicos')
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = coerencia, y = exclusividade, color = K)) +
  facet_wrap(~ K) +
  geom_point(shape = 16, size = 3, show.legend = FALSE) +
  scale_color_viridis_d(direction = -1, begin = 0.2, end = 0.9) +
  labs(
    x = 'Coerência Semântica',
    y = 'Exclusividade'
  )

# criando o painel
(fig_painel_metricas / fig_coerencia_exclusividade) +
  plot_layout(heights = c(1, 2)) +
  plot_annotation(
    title = 'Quantos tópicos devemos usar?', 
    subtitle = 'A quantidade de tópicos escolhida deve atender ao melhor balanço entre uma alta coerência semântica e exclusividade',
    tag_levels = 'A', tag_prefix = '(', tag_suffix = ')') & 
  theme(plot.tag = element_text(size = 10, face = 'bold'))

Ajustando o modelo

Ajustando o modelo de tópicos

# setando a seed
set.seed(33)

# buscando melhor valor de K
modelo <- stm(documents = df_esparsa, init.type = 'Spectral', seed = 333, 
              K = 18, verbose = FALSE)

Entendendo os tópicos

Visualizando os topicos encontrados.

Show code

# criando figura das palavras por topicos
tidy(x = modelo, matrix = 'beta') %>% 
  # agrupando pelo topico
  group_by(topic) %>% 
  # pegando as 10 palavras com maior afinade com cada tópico
  slice_max(order_by = beta, n = 10, with_ties = FALSE) %>% 
  # criando escala numerica para colorir dentro dos topicos
  mutate(escala = beta / max(beta)) %>% 
  # desagrupando os dados
  ungroup %>% 
  # organizando as informacoes para plotar
  mutate(
    topic = ifelse(test = topic < 10, 
                   yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
    term = reorder_within(x = term, by = beta, within = topic)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
  facet_wrap(~ topic, scales = 'free', ncol = 4) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_viridis_c(begin = 0.2, end = 0.9) +
  labs(
    title    = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
    x        = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
  ) +
  theme(axis.title.y = element_blank())

Visualizando os topicos encontrados - parte 2.

Show code

# extraindo os dados dos betas por topico
df_betas <- modelo$beta %>% 
  # pegando a matriz com o log das probabilidades para o beta
  pluck('logbeta') %>% 
  # parseando as matrizes para um dataframe
  map(.f = data.frame) %>% 
  # passando o log da probabilidade para probabilidade
  map(.f = exp) %>% 
  # colocando o nome nas colunas
  map(.f = ~ `colnames<-`(x = ., value = df_esparsa@Dimnames[[2]])) %>%
  # adicionando o identificador do topico a cada linha
  map(.f = mutate, topic = 1:n()) %>% 
  # renomeando os elementos da lista
  `names<-`(value = c('Monsters', 'Neutral', 'Nilfgaard', 'Northern Realms', 
                      "Scoia'tael", 'Skellige', 'Syndicate')) %>% 
  # juntando todos
  map_dfr(tibble, .id = 'slug') %>%
  # passando a base para o formato longo
  pivot_longer(cols = -c(slug, topic), names_to = 'term', values_to = 'beta')

# criando figura das palavras por topicos
df_betas %>% 
  # agrupando pelo topico e token
  group_by(topic, term) %>% 
  # calculando a media da probabilidade para aquele token naquele topico
  summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>% 
  # agrupando pelo topico
  group_by(topic) %>% 
  # pegando as 10 palavras com maior afinade com cada tópico
  slice_max(order_by = beta, n = 10, with_ties = FALSE) %>% 
  # criando escala numerica para colorir dentro dos topicos
  mutate(escala = beta / max(beta)) %>% 
  # desagrupando os dados
  ungroup %>% 
  # organizando as informacoes para plotar
  mutate(
    topic = ifelse(test = topic < 10, 
                   yes = paste0('Tópico 0', topic), no = paste0('Tópico', topic)),
    term = reorder_within(x = term, by = beta, within = topic)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = beta, y = term, fill = escala)) +
  facet_wrap(~ topic, scales = 'free', ncol = 4) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_viridis_c(begin = 0.2, end = 0.9) +
  labs(
    title    = 'Quais as palavras mais prováveis de serem observadas em cada tópico?',
    x        = expression(bold(paste('Probabilidade de ocorrência, ', beta)))
  ) +
  theme(axis.title.y = element_blank())

Visualizando a proporcao de topicos.

Show code

# criando tabela com as 5 palavras mais frequentes por topico para plotarmos abaixo
df_top_palavras <- tidy(x = modelo, matrix = 'beta') %>%
  # agrupando pelo topico
  group_by(topic) %>%
  # pegando as 10 palavras com maior afinade com cada tópico
  slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
  # colocando essas palavras em um vetor
  summarise(palavras = paste0(term, collapse = ', '))

# se usarmos o content quando rodar o STM, é necessário descomentar as linhas abaixo
# df_top_palavras <- df_betas %>%
#   # agrupando pelo topico e token
#   group_by(topic, term) %>% 
#   # calculando a media da probabilidade para aquele token naquele topico
#   summarise(beta = mean(x = beta, na.rm = TRUE), .groups = 'drop') %>% 
#   # agrupando pelo topico
#   group_by(topic) %>%
#   # pegando as 10 palavras com maior afinade com cada tópico
#   slice_max(order_by = beta, n = 5, with_ties = FALSE) %>%
#   # colocando essas palavras em um vetor
#   summarise(palavras = paste0(term, collapse = ', '))

# criando a figura de prevalencia por topico
tidy(x = modelo, matrix = 'gamma') %>% 
  # agrupando pelo topico
  group_by(topic) %>% 
  # extraindo a media da probabilidade para cada topico
  # esse é o valor esperado da prevalencia do tópico
  summarise(
    media = mean(x = gamma), .groups = 'drop'
  ) %>% 
  # juntando as 5 palavras mais frequentes por topico
  left_join(y = df_top_palavras, by = 'topic') %>% 
  # reordenando as colunas
  mutate(
    topic = ifelse(test = topic < 10, yes = paste0('0', topic), no = topic),
    topic = paste('Tópico', topic),
    topic = fct_reorder(.f = topic, .x = media)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = media, y = topic, fill = media)) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  geom_text(mapping = aes(label = round(x = media, digits = 3), color = media <= 0.04), 
            nudge_x = -0.01, fontface = 'bold', show.legend = FALSE) +
  geom_text(mapping = aes(label = palavras), nudge_x = 0.005, hjust = 0) +
  scale_x_continuous(breaks = seq(from = 0, to = 0.25, by = 0.05),
                     limits = c(0, 0.27)) +
  scale_fill_viridis_c(begin = 0.2, end = 0.9) +
  scale_color_manual(values = c('black', 'white')) +
  labs(
    title = 'Quais os tópicos mais prevalentes entre as cartas?',
    x     = expression(bold(paste('Probabilidade de ocorrência, ', gamma)))
  ) +
  theme(axis.title.y = element_blank())

Visualiza correlação entre topicos.

Show code

# carregando pacotes
library(corrr) # para o plot abaixo

# criando uma plot de correlacao entre os topicos
topicCorr(model = modelo) %>% 
  # pegando a matriz de correlacao
  pluck('cor') %>% 
  # colocando o nome das dimensoes
  `rownames<-`(value = paste0('Tópico ', 1:18)) %>% 
  `colnames<-`(value = paste0('Tópico ', 1:18)) %>% 
  # passando para uma matriz do corrr
  as_cordf() %>% 
  # passando a matriz de correlacao para o formato longo
  stretch(na.rm = TRUE, remove.dups = TRUE) %>% 
  # adicionando contagem de ocorrencias de x e y para ordenar as linhas
  # e colunas da figura
  add_count(x, name = 'n_x') %>% 
  add_count(y, name = 'n_y') %>% 
  mutate(
    y = fct_reorder(.f = y, .x = n_y, .desc = TRUE),
    x = fct_reorder(.f = x, .x = n_x, .desc = TRUE)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = x, y = y, fill = r)) +
  geom_tile(color = 'black') +
  geom_text(mapping = aes(label = round(x = r, digits = 2), color = abs(x = r) > 0.3), 
            fontface = 'bold', show.legend = FALSE) +
  scale_fill_gradient2(low = 'midnightblue', mid = 'white', high = 'firebrick', midpoint = 0) +
  scale_color_manual(values = c('NA', 'black')) +
  labs(
    title    = 'Qual a relação entre os tópicos identificados?',
    subtitle = 'São poucos os tópicos que compartilham algum tipo de relação'
  ) +
  theme(
    axis.title  = element_blank(),
    panel.grid  = element_blank(),
    axis.text.x = element_text(angle = 30, hjust = 1)
  )

Estimando a relacao entre topicos e metadados.

Show code

# estimando a contribuicao das features para explicar os clusters
explica_topicos <- estimateEffect(1:18 ~ 0 + slug, stmobj = modelo, 
                                  metadata = cartas, uncertainty = 'Global')

# pegando os slopes das regressoes
tidy(x = explica_topicos) %>% 
  # ajustando os dados para plotar
  mutate(
    # ajustando o nome das faccoes
    term  = str_remove(string = term, pattern = 'slug'),
    term  = str_replace_all(string = term, pattern = '\\(Intercept\\)', replacement = 'Monsters'),
    # criando codificacao de cor a partir do nome original da faccao
    cores = term,
    # ajustando o nome dos topicos
    topic = ifelse(test = topic < 10, yes = paste0('Tópico 0', topic), no = paste0('Tópico ', topic)),
    # ordenando as faccoes dentro dos topicos atraves da estimativa do slope
    term  = reorder_within(x = term, by = estimate, within = topic)
  ) %>% 
  # criando a figura
  ggplot(mapping = aes(x = estimate, y = term, fill = cores, group = 1)) +
  facet_wrap(~ topic, scales = 'free', ncol = 4) +
  geom_col(color = 'black', size = 0.3, show.legend = FALSE) +
  scale_y_reordered() +
  scale_fill_manual(values = cores_por_faccao) +
  labs(
    title = 'Quais as facções mais relacionadas com cada tópico?',
    x     = 'Coeficientes da regressão'
  ) +
  theme(axis.title.y = element_blank())

Utilizando os tópicos

Juntando probabilidades às cartas.

# pegando a matriz gamma - as probabilidade de cada topico por documento
embeddings <- tidy(x = modelo, matrix = 'gamma') %>% 
  # juntando o prefixo topic_ ao numero de cada topico
  mutate(topic = paste0('topic_', topic)) %>% 
  # pivoteando a tabela para o formato largo
  pivot_wider(id_cols = document, names_from = topic, values_from = gamma) %>% 
  # agrupando o dataframe por linha
  rowwise() %>% 
  # extraindo o topico mais provavel por linha
  mutate(
    topK = which.max(c_across(contains('topic_'))),
    topK = ifelse(test = topK < 10, yes = paste0('Tópico 0', topK), no = paste0('Tópico ', topK))
  ) %>% 
  # desagrupando o dataframe
  ungroup %>% 
  # colocando o nome das cartas na coluna do nome do documento
  mutate(document = cartas$localizedName) %>% 
  # juntando os metadados das cartas
  left_join(y = cartas, by = c('document' = 'localizedName'))
embeddings

# A tibble: 1,103 × 38
   document    topic_1 topic_2 topic_3 topic_4 topic_5 topic_6 topic_7
   <chr>         <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
 1 A Fera       0.0316  0.0332  0.0424 0.0106  0.0268  0.0849  0.00470
 2 A prática …  0.0167  0.0287  0.0481 0.0557  0.0341  0.0468  0.00585
 3 A Terra da…  0.0189  0.0473  0.217  0.0431  0.0249  0.0171  0.0122 
 4 A Trufa Ca…  0.0122  0.0621  0.0513 0.0582  0.0525  0.0129  0.0105 
 5 Abaya        0.0104  0.0338  0.0116 0.0229  0.00804 0.00995 0.00962
 6 Aberrações…  0.0211  0.0329  0.0166 0.00459 0.0219  0.0361  0.00431
 7 Abominação…  0.0997  0.0287  0.0440 0.00978 0.0335  0.0575  0.00421
 8 Acônito      0.0346  0.0199  0.0221 0.00995 0.00459 0.312   0.00299
 9 Açougueiro…  0.0267  0.0530  0.0191 0.00652 0.0146  0.0826  0.00914
10 Adaga Ceri…  0.0324  0.0815  0.0233 0.00861 0.0123  0.106   0.0129 
# … with 1,093 more rows, and 30 more variables: topic_8 <dbl>,
#   topic_9 <dbl>, topic_10 <dbl>, topic_11 <dbl>, topic_12 <dbl>,
#   topic_13 <dbl>, topic_14 <dbl>, topic_15 <dbl>, topic_16 <dbl>,
#   topic_17 <dbl>, topic_18 <dbl>, topK <chr>, name <chr>,
#   short <chr>, slug <chr>, rarity <chr>, cardGroup <chr>,
#   type <chr>, categoryName <chr>, ownable <lgl>, decks <int>,
#   craftingCost <int>, power <int>, provisionsCost <int>, …

Ajustando TSNE.

Show code

# carregando o pacote
library(Rtsne) # para rodar o TSNE
library(plotly) # para visualizar o TSNE

# setando a seed
set.seed(33)

# ajustando o TSNE
tsne_results <- select(embeddings, contains('topic_')) %>% 
  # passando objeto para matrix
  as.matrix() %>% 
  # ajustando tSNE
  Rtsne(check_duplicates = FALSE, perplexity = 20)

# plotando resultados do TSNE
tsne_results %>% 
  # pegando os resultado do TSNE
  pluck('Y') %>% 
  # passando para um dataframe
  data.frame %>% 
  # renomeando as colunas
  `names<-`(value = c('tsne1', 'tsne2')) %>% 
  # passando para um tibble
  tibble %>% 
  # juntando com o nome das cartas
  bind_cols(embeddings) %>% 
  # criando a figura
  plot_ly(x = ~ tsne1, y = ~ tsne2, color = ~ slug, data = ., colors = cores_por_faccao,
          mode = 'markers', type = 'scatter', marker = list(size = 7, opacity = 0.7),
          hoverinfo = 'text', 
          hovertext = ~ paste0(
            '<b>Tópico prevalente:</b> ', topK, '<br>',
            '<b>Carta:</b> ', document, '<br>',
            '<b>Raridade:</b> ', rarity, '<br>',
            '<b>Tipo:</b> ', type, '<br>',
            str_wrap(string = texto, width = 50)
            )
  ) %>% 
  layout(xaxis = list(title = 'Dimensão 1'), yaxis = list(title = 'Dimensão 2'))

Nearest neighbors.

# carregando funcoes
library(widyr) # para trabalhar em formato largo

# colocando os embeddings no formato para a funcao abaixo
df_embedding <- select(embeddings, document, contains('topic_')) %>% 
  # passando a base para o formato longo
  pivot_longer(cols = contains('topic_'), names_to = 'topico', values_to = 'probabilidade')

# criando funcao para calcular o nearest neighbors
nearest_neighbors <- function(df, carta, vizinhos) {
  
  # pegando a faccao da carta selecionada
  faccao_selecionada <- cartas %>% 
    # filtrando a carta selecionada
    filter(localizedName == carta) %>% 
    # pegando a faccao da carta
    pull(slug)
  
  # filtrando as cartas que serao comparadas
  if(faccao_selecionada != 'Neutral') {
  cartas_usaveis <- cartas %>% 
    # filtrando todas as cartas da faccao da carta selecionada
    filter(slug %in% faccao_selecionada) %>% 
    # pegando o nome das cartas
    pull(localizedName)
  # pegando todas as cartas caso a facção da carta alvo seja a neutra
  } else {
    cartas_usaveis <- pull(cartas, localizedName)
  }
  
  # calculando a similaridade de coseno entre todas as cartas e a carta alvo
  df %>%
    # filtrando apenas as cartas que serao comparadas
    filter(document %in% cartas_usaveis) %>% 
    # aplicando a funcao
    widely(
      ~ {
        # cria matriz n x m, onde n eh o numero de cartas que existem na base de dados, e m
        # é o número de tópicos identificados através do STM - o conteúdo de cada célular na
        # matriz é a probabilidade de que àquela carta esteja associada aquele tópico
        y <- .[rep(carta, nrow(.)), ]
        # no codigo abaixo o '.' representa a matriz de probablidades de cada carta possuir
        # cada tópico, e é uma matriz n x m onde o n é cada uma das cartas e o m corresponde
        # a várias colunas que representam cada um dos tópicos. Calcularemos então a similaridade
        # do conseno a carta selecionado e o embedding representado por cada outra carta:
        # - rowSums(. * y): multiplica a matriz do embedding de todos as cartas pela matriz
        # da carta selecionada
        # - sqrt(rowSums(. ^ 2)): retorna um vetor numerico, com um elemento por carta o valor
        # associado à cada carta representa o somatorio dos valores entre todas as dimensoes
        # de seu embedding (i.e., todos os topicos associado àquela carta)
        # sqrt(sum(.[token, ] ^ 2)): retorna um valor numérico, que representa o somatório dos
        # valores entre todas as dimensoes do embedding para a carta selecionada
        # (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[token, ] ^ 2))): multiplica o valor do embedding
        # de cada carta pelo da carta selecionado, padronizando a similaridade calculada
        # pelo 'rowSums(. * y)'
        similaridade_coseno <- rowSums(. * y) / (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[carta, ] ^ 2)))
        # coloca o resultado em uma matriz com o nome de linha vinda do nome das cartas
        #matrix(similaridade_coseno, ncol = 1, dimnames = list(x = names(similaridade_coseno)))
      },
      sort = TRUE
    )(document, topico, probabilidade) %>%
    # organizando as cartas em ordem decrescente de similaridade
    arrange(desc(item2)) %>% 
    # pegando apenas a quantidade desejada de cartas similares
    slice_max(order_by = item2, n = vizinhos) %>% 
    # juntando com metadados das cartas resultantes
    left_join(y = select(cartas, localizedName, slug, small, texto), by = c('item1' = 'localizedName'))
}

Exemplo Scoia’tael.

Show code

df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Bruxo Gato', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 90),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Northern Realms.

Show code

df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Imortais', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Nilfgaard.

Show code

df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Artorius Viggo', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, item2, texto) %>% 
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>%
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'), 
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Exemplo Neutral.

Show code

df_embedding %>% 
  # calculando o nearest neighbors
  nearest_neighbors(carta = 'Alzur', vizinhos = 5) %>% 
  # selecionando as colunas que vamos plotar
  select(small, item1, slug, item2, texto) %>%
  # adicionando o prefixo do link para a imagem
  mutate(small = paste0('https://www.playgwent.com/', small)) %>% 
  # colocando os exemplos em um reactable
  reactable(
    compact = TRUE, borderless = TRUE, defaultColDef = colDef(align = 'left'),
    style = list(fontFamily = "Roboto", fontSize = "12px"),
    columns = list(
      small = colDef(name = '', cell = embed_img(height = 80, width = 60), maxWidth = 80),
      item1 = colDef(name = 'Carta', maxWidth = 140),
      slug  = colDef(name = 'Facção', maxWidth = 90),
      item2 = colDef(name = 'Similaridade', maxWidth = 90, format = colFormat(digits = 3)),
      texto = colDef(name = 'Descrição')
    )
  )

Conclusões

Possíveis Extensões

Dúvidas, sugestões ou críticas? É só me procurar pelo e-mail ou GitHub!